modulo11

Otázka od: hlas

29. 4. 2004 13:44

ja som zohnal takuto funkciu,
vrati 0 ak je ucet ok

FUNCTION modulo(CUs:string):integer;
var s1:string[20];
    c1, c2, kc,i,j:integer;
BEGIN
  j:=length(CUs)+1;
  kc:=0;
  for i:=1 to j-1 do
  begin
    j:=j-1; c1:= strtoint(CUs[j]);
    if i=1 then kc:=1*c1;
    if i=2 then kc:=kc+(2*c1);
    if i=3 then kc:=kc+(4*c1);
    if i=4 then kc:=kc+(8*c1);
    if i=5 then kc:=kc+(5*c1);
    if i=6 then kc:=kc+(10*c1);
    if i=7 then kc:=kc+(9*c1);
    if i=8 then kc:=kc+(7*c1);
    if i=9 then kc:=kc+(3*c1);
    if i=10 then kc:=kc+(6*c1);
  end;
    c1:=floor(kc/11); c2:=ceil(kc/11);
    kc:=c2-c1;
    result:=kc;
END;

Odpovedá: Ing. Pavel Zilinec

29. 4. 2004 5:23

Sice jsou tam jeste nejake specialni fce, ale ty si lehce nahradis za
klasicke ...

procedure ExtractUcet(const AUcet : string; var APredcisli, ACisUctu : string);
var MyPomStr : string;
begin
  MyPomStr := ReplaceStr(AUcet, ' ', '');
  {Z poslaneho uctu odstranim pomlcku vzadu}
  if LeftStr(RightStr(MyPomStr, 4), 1) = '-' then
    MyPomStr := LeftStr(MyPomStr, Length(MyPomStr) - 4) + RightStr(MyPomStr,
3);
  {Pokud je tam '-', tak je to hned jasne}
  if Occurs('-', MyPomStr) > 0 then
  begin
    APredcisli := LeftStr(MyPomStr, Pos('-', MyPomStr) - 1);
    ACisUctu := RightStr(MyPomStr, Length(MyPomStr) - Length(APredcisli) -
1);
  end
  {Jinak to vezmu podle poctu znaku zprava}
  else
  begin
    ACisUctu := RightStr(MyPomStr, 10);
    if Length(MyPomStr) <= 10 then APredcisli := ''
    else APredcisli := LeftStr(MyPomStr, Length(MyPomStr) - 10);
  end;
  {Pokud je neco moc dlouhe, jde o chybu a vse bude nulove}
  if (Length(APredcisli) > 6) or (Length(ACisUctu) > 10) then
  begin
    APredcisli := '';
    ACisUctu := '';
  end;
  {Doplnim zleva nuly}
  APredcisli := StrPadL(APredcisli, 6, '0');
  ACisUctu := StrPadL(ACisUctu, 10, '0');
end;

function ValidateUcet(const AUcet : string; AHlaseni : Boolean) : Boolean;
const
  MyVahy : array [1..10] of Byte = (6, 3, 7, 9, 10, 5, 8, 4, 2, 1);
  MyVahyP : array [1..6] of Byte = ( 10, 5, 8, 4, 2, 1);
var
  i : Byte;
  MyVysledek : Integer;
  MyPredcisli, MyCisUctu : string;
begin
  Result := True;
  if Trim(AUcet) = '' then Exit;
  MyVysledek := 0;
  {Vytahnu si predcisli a samotne cislo}
  ExtractUcet(AUcet, MyPredcisli, MyCisUctu);
  {Musi tam byt jen cislice a nesmi to byt prazdne (pak tam byla chybna delka)}
  Result := StrToInt64Def(MyPredcisli + MyCisUctu, -1) > 0;
  {Kontrola predcisli}
  if Result then
  begin
    for i := 1 to 6 do
      MyVysledek := MyVysledek + StrToInt(MyPredcisli[i])*MyVahyP[i];
    if MyVysledek mod 11 <> 0 then Result := False;
  end;
  {Kontrola cisla uctu}
  if Result then
  begin
    for i := 1 to 10 do
      MyVysledek := MyVysledek + StrToInt(MyCisUctu[i])*MyVahy[i];
    if MyVysledek mod 11 <> 0 then Result := False;
  end;
  {Pripadna hlaska, pokud to chtel}
  if not Result and AHlaseni then
    PS_Upoz('', Format(PSApp.LocStr(9002), [AUcet]));
end;

--
ing. Pavel Zilinec
MailTo:zilinec@email.cz

Prog-Soft s.r.o. Plzen
Informacni system pro vyrobce
a distributory napoju

Wednesday, April 28, 2004, 11:13:39 PM, bylo napsano:

h> Neviete niekto poradit s algoritmom, resp. funkciou pre modulo11,
h> kontrola bankoveho uctu?

Odpovedá: Ing. Pavel Zilinec

29. 4. 2004 13:43

To urcite take souhlasi, ale predpokalda to, ze je ucet zadany na
plny pocet mist s uvodnimi nulami a bez pomlcek.
Me fce predpokladaji take spravne zadany ucet, ale napsany s
pripustnymi (!) pomlckami a s moznym (!) vynechanim tech uvodnich nul.

--
ing. Pavel Zilinec
MailTo:zilinec@email.cz

Prog-Soft s.r.o. Plzen
Informacni system pro vyrobce
a distributory napoju

Thursday, April 29, 2004, 1:46:46 PM, bylo napsano:

h> ja som zohnal takuto funkciu,
h> vrati 0 ak je ucet ok

h> FUNCTION modulo(CUs:string):integer;
h> var s1:string[20];
h> c1, c2, kc,i,j:integer;
h> BEGIN
h> j:=length(CUs)+1;
h> kc:=0;
h> for i:=1 to j-1 do
h> begin
h> j:=j-1; c1:= strtoint(CUs[j]);
h> if i=1 then kc:=1*c1;
h> if i=2 then kc:=kc+(2*c1);
h> if i=3 then kc:=kc+(4*c1);
h> if i=4 then kc:=kc+(8*c1);
h> if i=5 then kc:=kc+(5*c1);
h> if i=6 then kc:=kc+(10*c1);
h> if i=7 then kc:=kc+(9*c1);
h> if i=8 then kc:=kc+(7*c1);
h> if i=9 then kc:=kc+(3*c1);
h> if i=10 then kc:=kc+(6*c1);
h> end;
h> c1:=floor(kc/11); c2:=ceil(kc/11);
h> kc:=c2-c1;
h> result:=kc;
h> END;

h> __________ Informace od NOD32 1.742 (20040428) __________

h> Tato zprava byla proverena antivirovym systemem NOD32.
h> http://www.nod32.cz